{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveDataTypeable #-}

module Imj.Music.Instruments
    ( InstrumentId(..)
    , Instruments(..)
    , mkEmptyInstruments
    , mkInstruments
    , lookupInstrument
    , insertInstrument
    , registerInstrument
    , InstrumentVersion(..)
    , mkInstrumentVersion
    ) where

import           Imj.Prelude
import           Data.Bits(shiftL)
import           Data.Data(Data(..))
import           Data.Map.Strict(Map)
import qualified Data.Map.Strict as Map
import           Data.Word(Word64, Word32)
import           Data.Tuple(swap)

import           Imj.Audio.Midi
import           Imj.Music.Instrument

-- | Each client should be able to generate 'InstrumentId's that do not overlap
-- with the ones generated by other clients.
newtype InstrumentId = InstrumentId Word64
  deriving(Generic,Show, Eq, Ord)
instance Binary InstrumentId
instance NFData InstrumentId

newtype InstrumentVersion = InstrumentVersion Word32
  deriving(Generic,Show, Eq, Ord, Data, Integral, Num, Real, Enum)
instance Binary InstrumentVersion
instance NFData InstrumentVersion

mkInstrumentVersion :: InstrumentVersion
mkInstrumentVersion = InstrumentVersion 0

mkInstrumentId :: InstrumentVersion -> MidiSourceIdx -> InstrumentId
mkInstrumentId v midi = InstrumentId $ ((fromIntegral midi :: Word64) `shiftL` 32) + (fromIntegral v :: Word64)

data Instruments = Instruments {
    instrToId :: !(Map Instrument   InstrumentId)
  , idToInstr :: !(Map InstrumentId Instrument)
  , nextInstrumentVersion :: !InstrumentVersion
} deriving(Generic)
instance NFData Instruments

-- | Note that it's possible that two 'Instrument's compare equal.
mkInstruments :: Map InstrumentId Instrument
              -> Instruments
mkInstruments m = Instruments rev m 0
 where
  rev = Map.fromList $ map swap $ Map.assocs m

mkEmptyInstruments :: Instruments
mkEmptyInstruments = mkInstruments mempty

lookupInstrument :: Instrument -> Instruments -> Maybe InstrumentId
lookupInstrument i (Instruments a _ _) = Map.lookup i a

insertInstrument :: MidiSourceIdx -> Instrument -> Instruments -> (Instruments, InstrumentId)
insertInstrument midiIdx i (Instruments a b c) =
  (registerInstrument iid i $ Instruments a b $ c+1, iid)
 where
  iid = mkInstrumentId c midiIdx

registerInstrument :: InstrumentId -> Instrument -> Instruments -> Instruments
registerInstrument iid i (Instruments a b c) =
  Instruments a' b' c
 where
  a' = Map.insert i iid a
  b' = Map.insert iid i b
